Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/demostuf/rubber2.pas

Pascal/Delphi Source File | 1994-07-25 | 9.2 KB | 573 lines

program rubbervector1;
{
    RubberVector #1
    - by Bjarke Viksoe
    16/2/1994

  THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  E-MAIL ME AT: [e-mail] IN 1994 FOR CHAT AND CODE.

    - must run in protected mode to have enough memory...
}

uses
    DEMOINIT;

const
    DEBUG = FALSE;
    ANTAL_FACES = 6;
    ANTAL_COORDS = 8;

    box = 89;
    ANIMWIDTH = 40;
    ANIMHEIGHT = 100;
    ANTAL_ANIMS = ANIMHEIGHT;

type
    pAnim = ^animtype;
    animtype = array[0..ANIMWIDTH*ANIMHEIGHT*4] of byte;

    facetype = RECORD
        l1,l2,l3,l4 : byte;
    end;

var
    slope                    : array[0..399] of integer;
    face                    : array[1..ANTAL_FACES] of facetype;
    light                    : array[1..ANTAL_FACES] of byte;
    cbuffer                : array[0..ANTAL_COORDS*2-1] of integer;
    miny,maxy             : integer;

    i : integer;
    xkoord,ykoord,zkoord : integer;

    sinustabel            : array[0..1279] of integer;
    v1,v2,v3                : word;
    cos1,sin1,cos2,sin2,cos3,sin3 : integer;

    animpos : integer;
    anim : array[0..ANTAL_ANIMS] of pAnim;
    animytabel : array[0..200] of word;


const
    display1 : integer = $0000;
    display2 : integer = $4000;
    coords : array[0..ANTAL_COORDS*3-1] of integer =
        (box,box,-box, -box,box,-box, -box,-box,-box, box,-box,-box,
        box,box,box, -box,box,box, -box,-box,box, box,-box,box);


(*------------------------------------------------*)

procedure SetupSinus;
var
    i : integer;
    v, vadd : real;
begin
    v:=0.0;
    vadd:=(2.0*pi/1024.0);
    for i:=0 to 1279 do begin
        sinustabel[i]:=round(sin(v)*32767);
        v:=v+vadd;
    end;
end;

procedure SetupCoords;
begin
    with face[1] do begin l1:=3; l2:=2; l3:=1; l4:=0; end;
    with face[2] do begin l1:=4; l2:=5; l3:=6; l4:=7; end;
    with face[3] do begin l1:=0; l2:=1; l3:=5; l4:=4; end;
    with face[4] do begin l1:=1; l2:=2; l3:=6; l4:=5; end;
    with face[5] do begin l1:=2; l2:=3; l3:=7; l4:=6; end;
    with face[6] do begin l1:=3; l2:=0; l3:=4; l4:=7; end;
end;

procedure SetupColors;
var
    i : integer;
begin
    for i:=0 to 63 do setRGB(i, 0,i,0);
    for i:=64 to 127 do setRGB(i, 0,127-i,0);
    for i:=128 to 192 do setRGB(i, 0,i-128,0);
    setRGB(0, 2,4,8);
end;

procedure InitDemo;
var
    i : integer;
begin
    ClearWholeScreen;

    SetupSinus;
    SetupColors;
    SetupCoords;

    for i:=0 to ANTAL_ANIMS do begin
        new(anim[i]);
        fillchar(anim[i]^,ANIMWIDTH*ANIMHEIGHT*4,0);
    end;
    for i:=0 to 200 do animytabel[i]:=i*ANIMWIDTH;

    v1:=0; v2:=0; v3:=0;
    animpos:=0;
end;

procedure UnInitDemo;
var
    i : integer;
begin
    for i:=0 to ANTAL_ANIMS do dispose(anim[i]);
end;


(*------------------------------------------------*)

procedure SwapDisplay;
var
    temp : word;
begin
    temp:=display2;
    display2:=display1;
    display1:=temp;
    SetAddress(Ptr(SEGA000,display1));
end;

procedure ClearScreen(anim : pAnim); assembler;
asm
    les    di,anim
    DB $66,$33,$c0        {xor eax,eax}
    mov    cx,ANIMWIDTH*ANIMHEIGHT
    cld
    DB $F3,$66,$AB        {rep stosd}
end;


(*------------------------------------------------*)

procedure ClearSlope; assembler;
asm
    mov    ax,ds
    mov    es,ax
    lea    di,slope
    DB $66,$B8,$00,$80,$00,$80        {MOV AX,$80008000}
    cld
    mov    cx,200
    DB $F3,$66,$AB                        {REP STOSD}
end;

procedure CalcSlope(l1,l2 : integer); assembler;
var
    ysize : integer;
asm
    lea    si,cbuffer
    mov    bx,l1
    shl    bx,2
    mov    cx,[si+bx]
    mov    dx,[si+bx+2]
    mov    bx,l2
    shl    bx,2
    add    si,bx
    mov    ax,[si]
    mov    bx,[si+2]

    cmp    bx,dx
    jle    @noswap
    xchg    ax,cx
    xchg    bx,dx
@noswap:
    cmp    bx,miny
    jae    @miny
    mov    miny,bx
@miny:
    cmp    dx,maxy
    jbe    @maxy
    mov    maxy,dx
@maxy:

    sub    dx,bx
    mov    ysize,dx
    add    bx,bx
    add    bx,bx
    lea    si,slope
    add    si,bx

    push    ax
    sub    cx,ax
    inc    cx

    and    dx,dx
    jz        @zero
    cmp    dl,1
    jne    @not1
    dec    cx
    mov    dx,cx
    xor    ax,ax
    jmp    @one
@not1:
    cmp    dl,2
    jne    @not2
    mov    ax,$7FFF
    imul    cx
    jmp    @one
@not2:

    mov    dx,$0001
    mov    ax,$0000
    idiv    ysize
    imul    cx
@one:
    pop    cx
    xor    bx,bx

    mov    di,$8000
@loop:
    cmp    [si],di
    jne    @other
    mov    [si],cx
    add    si,4
    add    bx,ax
    adc    cx,dx
    dec    ysize
    jnz    @loop
    jmp    @zero
@other:
    mov    [si+2],cx
    add    si,4
    add    bx,ax
    adc    cx,dx
    dec    ysize
    jnz    @loop
@zero:
end;


(*------------------------------------------------*)

procedure CalcVinkel;
begin
    sin1:=sinustabel[v1];
    cos1:=sinustabel[v1+256];
    sin2:=sinustabel[v2];
    cos2:=sinustabel[v2+256];
    sin3:=sinustabel[v3];
    cos3:=sinustabel[v3+256];

    v1:=(v1+2) AND 1023;
    v2:=(v2-2) AND 1023;
    v3:=(v3+1) AND 1023;
end;

procedure RotateAllCoords; assembler;
asm
    mov    ax,ds
    mov    es,ax
    lea    si,coords
    lea    di,cbuffer
    mov    i,ANTAL_COORDS
    cld
@loop:
    lodsw
    mov    xkoord,ax
    lodsw
    mov    ykoord,ax
    lodsw
    mov    zkoord,ax

    mov    ax,xkoord               {rotate around Z-axis}
    push    ax
    imul    Cos1
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,ykoord
    imul    Sin1
    add    ax,ax
    adc    dx,dx
    sub    bx,dx
    mov    xkoord,bx
    pop    ax
    imul    Sin1
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,ykoord
    imul    Cos1
    add    ax,ax
    adc    dx,dx
    add    bx,dx
    mov    ykoord,bx

    mov    ax,ykoord               {rotate around Y-axis}
    push    ax
    imul    Cos2
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,zkoord
    imul    Sin2
    add    ax,ax
    adc    dx,dx
    sub    bx,dx
    mov    ykoord,bx
    pop    ax
    imul    Sin2
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,zkoord
    imul    Cos2
    add    ax,ax
    adc    dx,dx
    add    bx,dx
    mov    zkoord,bx

    mov    ax,xkoord               {rotate around X-axis}
    push    ax
    imul    Cos3
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,zkoord
    imul    Sin3
    add    ax,ax
    adc    dx,dx
    sub   bx,dx
    mov    xkoord,bx
    pop    ax
    imul    Sin3
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,zkoord
    imul    Cos3
    add    ax,ax
    adc    dx,dx
    add    bx,dx
    mov    zkoord,bx

    add    bx,800
    and    bx,bx
    jnz    @zero
    mov    bl,1
@zero:

    mov        ax,xkoord
    cwd
    mov        dl,ah
    mov        ah,al
    xor        al,al
    idiv        bx
    add        ax,80
    stosw

    mov        ax,ykoord
    cwd
    mov        dl,ah
    mov        ah,al
    xor        al,al
    idiv        bx
    add        ax,50
    stosw

    dec        i
    jne        @loop
end;


function FaceShown(i : integer; l1,l2,l3 : byte) : boolean;
var
    a,b : longint;
begin
    a := (cbuffer[l1]-cbuffer[l2])*(cbuffer[l3+1]-cbuffer[l2+1]);
    b := (cbuffer[l1+1]-cbuffer[l2+1])*(cbuffer[l3]-cbuffer[l2]);
    light[i] := ((a-b) DIV 70)+1;
    FaceShown := (a-b) > 0;
end;


procedure FillShape(anim : pAnim; y,ysize : integer; color : byte); assembler;
const
    PSIZE = ANIMWIDTH*ANIMHEIGHT;
    planeadd : array[0..3] of word = (0,PSIZE,PSIZE*2,PSIZE*3);
asm
    mov    ax,y
    add    ax,ax
    mov    si,ax
    les    di,anim
    add    di,[si+OFFSET animytabel]
    lea    si,slope
    add    ax,ax
    add    si,ax

    cld
@yloop:
    lodsw
    mov    dx,ax
    lodsw
    cmp    ax,dx
    jle    @exchange
    xchg    ax,dx
@exchange:
    push    di

    mov    bx,ax
    sub    dx,ax            {calc xsize in DX}
    cmp    dx,0
    jle    @drawn
    cmp    dx,ANIMWIDTH*4
    jge    @drawn
    shr    ax,2            {calc xpos}
    add    di,ax

    and    bx,3
    add    bl,bl
    add    di,WORD PTR [planeadd+bx]
    shr    bl,1
    mov    ah,4
    sub    ah,bl

    mov    cx,dx
    mov    dx,ANIMWIDTH*ANIMHEIGHT
    mov    bx,(ANIMWIDTH*ANIMHEIGHT*4)-1
    mov    al,color
@xloop:
    mov    es:[di],al
    add    di,dx
    dec    ah
    jnz    @noswap
    mov    ah,4
    sub    di,bx
@noswap:
    inc    al
    loop    @xloop

@drawn:
    pop    di
    add    di,ANIMWIDTH
    dec    ysize
    jnz    @yloop
end;


procedure PrintJellyLogo;
var
    i,pos : integer;
    aptr : pAnim;
    source_offset, dest_offset : word;
    colorptr : pointer;
begin
    pos:=animpos;
    source_offset:=0;                                    {start with 1. line...}
    dest_offset:=20+(50*WIDTH)+display1;        {start pos on screen}
    for i:=0 to ANIMHEIGHT-1 do begin
        aptr:=@anim[pos]^;
        asm
            push    ds
            cli
            mov    dx,$3C4
            mov    al,$02
            out    dx,al
            inc    dx
            mov    al,$01
            out    dx,al
            sti
            mov    es,SEGA000
            mov    di,dest_offset
            lds    si,aptr
            add    si,source_offset
            cld
            mov    cx,ANIMWIDTH/2
            rep movsw

            cli
            mov    dx,$3C4
            mov    al,$02
            out    dx,al
            inc    dx
            mov    al,$02
            out    dx,al
            sti
            mov    di,dest_offset
            add    si,(ANIMWIDTH*ANIMHEIGHT)-ANIMWIDTH
            mov    cx,ANIMWIDTH/2
            rep movsw

            cli
            mov    dx,$3C4
            mov    al,$02
            out    dx,al
            inc    dx
            mov    al,$04
            out    dx,al
            sti
            mov    di,dest_offset
            add    si,(ANIMWIDTH*ANIMHEIGHT)-ANIMWIDTH
            mov    cx,ANIMWIDTH/2
            rep movsw

            cli
            mov    dx,$3C4
            mov    al,$02
            out    dx,al
            inc    dx
            mov    al,$08
            out    dx,al
            sti
            mov    di,dest_offset
            add    si,(ANIMWIDTH*ANIMHEIGHT)-ANIMWIDTH
            mov    cx,ANIMWIDTH/2
            rep movsw
            pop    ds
        end;
        inc(source_offset,ANIMWIDTH);
        inc(dest_offset,WIDTH);
        inc(pos); if (pos > ANTAL_ANIMS) then pos:=0;
    end;
end;


(*------------------------------------------------*)

procedure RunOnce;
var
    i : integer;
begin
    SwapDisplay;
    while retraces=0 do ;
    retraces:=0;
    if DEBUG then SetRGB(0,30,0,0);

    ClearScreen(anim[animpos]);

    CalcVinkel;
    RotateAllCoords;

    for i:=1 to ANTAL_FACES do begin
        with face[i] do if FaceShown(i, l1 shl 1,l2 shl 1,l3 shl 1) then begin
            ClearSlope;
            miny := 200; maxy := 0;
            CalcSlope(l1,l2);
            CalcSlope(l2,l3);
            CalcSlope(l3,l4);
            CalcSlope(l4,l1);
            FillShape(anim[animpos], miny, maxy-miny, light[i]);
        end;
    end;
    PrintJellyLogo;
    inc(animpos); if (animpos > ANTAL_ANIMS) then animpos:=0;
    if DEBUG then SetRGB(0,0,0,0);
end;


begin
    OpenScreen;
    InitDemo;
    SetAllInterrupts;
    repeat RunOnce until KeyPressed;
    RestoreAllInterrupts;
    UninitDemo;
    CloseScreen;
end.